home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / dgsay.exe / lha / DGSTR.PAS < prev    next >
Pascal/Delphi Source File  |  1989-06-29  |  23KB  |  791 lines
  1. {
  2.  ╔═════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                         ║
  4.  ║        TITLE :      DGSTR.TPU,  Version 8907.01                         ║
  5.  ║      PURPOSE :      String Object and String Handling Routines          ║
  6.  ║       AUTHOR :      David Gerrold, CompuServe ID:  70307,544            ║
  7.  ║  _____________________________________________________________________  ║
  8.  ║                                                                         ║
  9.  ║   Written in Turbo Pascal, Version 5.5,                                 ║
  10.  ║   with routines from Turbo Professional, Version 5.0.                   ║
  11.  ║                                                                         ║
  12.  ║   Turbo Pascal is a product of Borland International.                   ║
  13.  ║   Turbo Professional is a product of TurboPower Software                ║
  14.  ║  _____________________________________________________________________  ║
  15.  ║                                                                         ║
  16.  ║  This is not public domain software.  This is shareware.                ║
  17.  ║  This software is copyright 1989, by David Gerrold.                     ║
  18.  ║                                                                         ║
  19.  ║        The Brass Cannon Corporation                                     ║
  20.  ║        9420 Reseda Blvd., #804                                          ║
  21.  ║        Northridge, CA 91324-2932.                                       ║
  22.  ║                                                                         ║
  23.  ║  If you find this code useful, a donation of $25 is requested --        ║
  24.  ║  not to me, but to the AIDS Project Los Angeles.  Donations may         ║
  25.  ║  be forwarded via the Brass Cannon address.  Thank you.                 ║
  26.  ║                                                                         ║
  27.  ╚═════════════════════════════════════════════════════════════════════════╝
  28.                                                                             }
  29. { ========================================================================= }
  30. {  Compiler Directives :                                                    }
  31. { ========================================================================= }
  32.  
  33. {$R-}    {Range checking off}
  34. {$B+}    {Boolean complete evaluation on}
  35. {$S+}    {Stack checking on}
  36. {$I+}    {I/O checking on}
  37. {$N+,E+} {Simulate numeric coprocessor}
  38. {$M 65500,16384,655360} {Turbo 3 default stack and heap}
  39. {$V-}    {Variable range checking off}
  40.  
  41. { ========================================================================= }
  42. UNIT DgStr;
  43. { ========================================================================= }
  44.  
  45. INTERFACE
  46.  
  47. USES
  48.   TpString,                                      { Turbo Power unit }
  49.   DgInit;                                        { Dg Initializations }
  50.  
  51. TYPE
  52.   StrOb = Object (LocOb)
  53.     S : string;
  54.  
  55.     Procedure  AcceptStr (NewStr : string);
  56.     Procedure  AcceptRaw (RawStr : string);
  57.     Procedure  UpStr;
  58.     Procedure  LoStr;
  59.     Procedure  UpCaseFirstLetter;
  60.     Procedure  TrimLeadCh  (Ch : char);
  61.     Procedure  TrimTrailCh (Ch : char);
  62.     Procedure  TrimCh      (Ch : char);
  63.     Procedure  StripOut    (Ch : char);
  64.     Procedure  OverWrite   (Position : byte;  OverStr : string);
  65.     Procedure  Replace     (OldStr, NewStr : string);
  66.     Procedure  Translate   (OldCh, NewCh : char);
  67.     Procedure  Append      (NewStr : string);
  68.     Procedure  AppendWord  (NewStr : string);
  69.     Procedure  HeadAppend  (NewStr : string);
  70.     Procedure  Compress;
  71.     Procedure  DeCompress;
  72.  
  73.     Function   L           : byte;
  74.     Function   LastPos     (PosCh : char) : byte;
  75.     Function   SubStr      (Pos1, Pos2 : byte) : string;
  76.     Function   ExtractFirstWord    : string;
  77.     Function   TrimThe             : string;
  78.   end;
  79.  
  80. { ========================================================================= }
  81.  
  82. FUNCTION TrimLeadChars (S : string;  Ch : char) : string;
  83. { Trims all occurrences of Ch from the beginning of a string. }
  84.  
  85. FUNCTION TrimTrailChars (S : string;  Ch : char) : string;
  86. { Trims all occurrences of Ch from the end of a string. }
  87.  
  88. FUNCTION TrimChars (S : string;  Ch : char) : string;
  89. { Trims all occurrences of Ch from the beginning and end of a string. }
  90.  
  91. FUNCTION InCap (Ch : char) : boolean;
  92. { Returns true if letter is upper case. }
  93.  
  94. FUNCTION Capitalize (S : string) : string;
  95. { Capitalizes the first letter in the string. }
  96.  
  97. FUNCTION CapitalizeAll (S : string) : string;
  98. { Capitalizes every word in the string. }
  99.  
  100. PROCEDURE ReplaceOnce (Var S : string;  OldStr, NewStr : string);
  101. { Finds OldStr in S and replaces it with NewStr. }
  102.  
  103. PROCEDURE ReplaceAll (Var S : string;  OldStr, NewStr : string);
  104. { Replaces all occurrences of OldStr with NewStr. }
  105.  
  106. FUNCTION GetSubStr (S : string; Pos1, Pos2 : byte) : string;
  107. { Extracts a SubString, starting at Pos1, ending at Pos2. }
  108.  
  109. FUNCTION Num2Str (Num : extended) : string;
  110. { Returns any number in shortest possible string. }
  111.  
  112. FUNCTION Str2Num (S : string) : real;
  113. { Turns a number in a string into a real number. }
  114.  
  115. FUNCTION InAlphabet (Ch : char) : boolean;
  116. { Returns true if ch in Alphabet. }
  117.  
  118. FUNCTION InNumbers (Ch : char) : boolean;
  119. { Returns true if ch is a number. }
  120.  
  121. FUNCTION InApostrophe (Ch : char) : boolean;
  122. { Returns true if ch is apostrophe. }
  123.  
  124. FUNCTION InTwoSpacePunctuation (Ch : char) : boolean;
  125. { Returns true if ch in two space punctuation. }
  126.  
  127. FUNCTION InPunctuation (Ch : char) : boolean;
  128. { Returns true if ch in punctuation. }
  129.  
  130. { ========================================================================= }
  131. { ========================================================================= }
  132.  
  133. IMPLEMENTATION
  134.  
  135. { ========================================================================= }
  136.  
  137. FUNCTION TrimLeadChars (S : string;  Ch : char) : string;
  138. {
  139.   Trims all occurrences of Ch from the beginning of S.
  140. }
  141.  
  142. VAR
  143.   Len  : byte absolute S;
  144.  
  145. BEGIN
  146.   While
  147.     (S [1] = Ch) and (Len > 0)                   { while S [1] = Ch }
  148.   do
  149.     begin
  150.     dec (Len);                                   { shorten S }
  151.     move (S [2], S [1], Len);                    { delete 1st char }
  152.     end;
  153.   TrimLeadChars := S;                            { return }
  154. END;
  155.  
  156. { ========================================================================= }
  157.  
  158. FUNCTION TrimTrailChars (S : string;  Ch : char) : string;
  159. {
  160.   Trims all occurrences of Ch from the end of S.
  161. }
  162.  
  163. VAR
  164.   Len  : byte absolute S;
  165.  
  166. BEGIN
  167.   While
  168.     (S [Len] = Ch)                               { while last char = Ch }
  169.   do
  170.     dec (Len);                                   { shorten S }
  171.   TrimTrailChars := S;                           { return }
  172. END;
  173.  
  174. { ========================================================================= }
  175.  
  176. FUNCTION TrimChars (S : string;  Ch : char) : string;
  177. {
  178.   Trims all occurrences of Ch from both the beginning and end of S.
  179. }
  180. BEGIN
  181.   TrimChars := TrimTrailChars (TrimLeadChars (S, Ch), Ch);
  182. END;
  183.  
  184. { ========================================================================= }
  185.  
  186. PROCEDURE StrOb.AcceptStr (NewStr : string);
  187. {
  188.   Accept a new string into S.
  189. }
  190. BEGIN
  191.   S := NewStr;
  192. END;
  193.  
  194. { ========================================================================= }
  195.  
  196. PROCEDURE StrOb.AcceptRaw (RawStr : String);
  197. {
  198.   Takes raw variable strings, such as those found in Turbo Pascal code,
  199.   and converts them to standard text strings.
  200.  
  201.   Will translate #39 into ' and ^E into Ctrl-E, etc.
  202.  
  203.   Useful for translating text strings from files.  No real
  204.   error-trapping here.  Routine tends to ignore what it doesn't
  205.   understand.  Nevertheless, use with caution.  Make sure input
  206.   strings are valid or results may be unpredictable.
  207. }
  208.  
  209. VAR
  210.   LenRawStr  : byte absolute RawStr;
  211.   Loop       : byte;
  212.   NumStr     : string [2];
  213.   Trash      : word;
  214.   Ch         : char;
  215.  
  216. BEGIN
  217. Loop := 1;
  218. S := '';
  219. While
  220.   Loop <= LenRawStr
  221. Do
  222.   Begin
  223.   Case RawStr [Loop] of
  224.     '^' : begin